perm filename PPSAV.FAI[HAK,HPM] blob sn#173096 filedate 1976-07-08 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	PPSAV
C00003 00003	BEG:	TDZA	A,A			START HERE
C00006 00004	REEGO:	SETZM	CRTERM#
C00007 00005	TAB:	PUSHJ P,WRCH
C00009 00006	RCHNW:	MOVE C,[700,,WRD-1]
C00011 00007	FILE NAME SCANNER.  ERROR ROUTINES.
C00016 ENDMK
C⊗;
	TITLE	PPSAV
;		Modified to accept filename AJT March 1975
;Modified to use low core pointers instead of EDDT syms--ME August 1975

	A←1
	B←2
	C←3
	D←4
	E←5
	T←15
	TT←16
	P←17

	LPDL←←69

DEFINE SYMS{FOR X IN(JBTLIN,LETAB,PPCALL,TPJMP,TBLKPT)}


EXTERN JOBREL,JOBFF

	LOC 124
	REE
	RELOC 0

BEG:	TDZA	A,A			;START HERE
REE:	MOVNI	A,1
	MOVEM	A,REESW#
	MOVE	P,[-LPDL,,PDL]
	RESET
	MOVSI	A,1777
	SETPR2	A,
	JRST	BEG0
	SKIPN	A,400321
	JRST	BEG0		;This system version doesn't have my pointers.
	HLRZM	A,TBLKPT
	HRRZM	A,TPJMP
	MOVE	A,400322
	HRRZM	A,PPCALL
	MOVE	A,400236
	MOVEM	A,JBTLIN
	MOVE	A,400237
	MOVEM	A,LETAB
	JRST	BEG0A		;OK, got values from low core words.

BEG0:	PUSHJ	P,LOOK
	JRST	SYMERR
BEG0A:	PUSHJ	P,FSCAN			;LOOK FOR A FILENAME 
	MOVE	A,[FILE,,ENTR]
	BLT	A,ENTR+3
	OPEN	[0↔'DSK   '↔OBUF,,IBUF]
	JRST	4,.
	ENTER	ENTR	
	JRST	ENTFAI
	MOVSI	A,376000
	SETPR2	A,
	JRST	4,.
	SKIPE	REESW#
	JRST	REEGO
BEG1:	PJOB	A,
	ADD	A,JBTLIN
	HRRE	A,400000(A)
	JUMPL	A,[EXIT]		;DETACHED
BEG2:	CAIL	A,20
	CAIL	A,120
	JRST	[OUTSTR[ASCIZ/DPYS ONLY
/]
		EXIT]
	ADD	A,LETAB
	HRRZ	A,400000-20(A)
	JUMPE	A,[OUTSTR[ASCIZ/NOT IN USE
/]
		EXIT]
	HRLZ	T,400037
	TLZN	T,400000
	JRST	BEG3
	HRRI	T,400000
	SETPR2	T,
	JRST	4,.
BEG3:	TRC	T,400000
	HRRM	T,APNT
	SUBI	T,2
	HRLI	T,-20
	MOVSM	T,JMPOFF#
	ADD	A,PPCALL
	HLRZ	A,@APNT
	MOVEI	B,1(A)
	ADD	B,TPJMP
	HRLM	B,ENDTST
	ADD	A,TBLKPT
	HRRZ	A,@APNT
	ADD	A,APNT
	HRLI	A,444400
	MOVEM	A,WRDP#
	SETZM	CCNT#
	MOVNI	A,69
	MOVEM	A,BLKCNT#
	JRST	LF1

MAIN:	PUSHJ	P,RCH
	JRST	DONE
MAINR:	CAIN	C,11
	JRST	TAB
	CAIN	C,12
	JRST	LF
	CAIE	C,13
	CAIN	C,14
	JRST	QUOTIT
MAINW:	PUSHJ	P,WRCH
	JRST	MAIN
REEGO:	SETZM	CRTERM#
	OUTSTR	[ASCIZ/LINE?/]
	MOVEI	A,0
REELUP:	INCHWL	C
	CAIN	C,175
	JRST	BEG2
	CAIN	C,15
	JRST	GOTCR
	LSH	A,3
	ADDI	A,-"0"(C)
	JRST	REELUP

GOTCR:	INCHRW	T
	SETOM	CRTERM
	JRST	BEG2
TAB:	PUSHJ P,WRCH
	MOVEI A,
TABL:	PUSHJ P,RCH
	JRST TABX
	CAIN C,40
	AOJA A,TABL
	CAIN C,11
	JRST MAIN
	PUSHJ P,OOPS
	JRST MAINR

TABX:	PUSHJ P,OOPS
	JRST DONE

LF:	PUSHJ P,WRCH
LF1:	PUSHJ P,RCH
	JRST DONE
	CAIE C,40
	JRST MAINR
	PUSHJ P,RCH
	JRST LF2
	CAIN C,15
	JRST MAINR
	PUSH P,C
	MOVEI C,40
	PUSHJ P,WRCH
	POP P,C
	JRST MAINR

LF2:	MOVEI C,40
	PUSHJ P,WRCH
DONE:	CLOSE
	SKIPE REESW
	SKIPE CRTERM
	EXIT
	SETZM	ENTR+3
	LOOKUP	ENTR
	JRST	[OUTSTR [ASCIZ /FILE WENT AWAY?
/]
		CALLI 12]
TLUP:	SOSG	IBUF+2
	IN
	JRST	.+2
	EXIT
	ILDB	T,IBUF+1
	OUTCHR	T
	JRST	TLUP

QUOTIT:	PUSH P,C
	MOVEI C,177
	PUSHJ P,WRCH
	POP P,C
	JRST MAINW
RCHNW:	MOVE C,[700,,WRD-1]
	MOVEM C,CHRP#
	MOVEI C,5
	MOVEM C,CCNT
RCHNW2:	ILDB C,WRDP
	TRNN C,1
	JRST RCHNB
	MOVEM C,WRD
RCH:	SOSGE CCNT
	JRST RCHNW
	ILDB C,CHRP
	JUMPE C,RCH
	AOS (P)
CPOPJ:	POPJ P,

RCHNB:	CAMN C,ENDTST
	POPJ P,
	ADD C,JMPOFF
	TRNN C,-1
	AOSLE BLKCNT
	JRST UNEX
	HLRM C,WRDP
	JRST RCHNW2

WRCH:	SOSG OBUF+2
	OUTPUT
	IDPB C,OBUF+1
	POPJ P,

OOPS:	JUMPE A,CPOPJ
	PUSH P,C
	MOVEI C,40
	PUSHJ P,WRCH
	SOJG A,.-1
	POP P,C
	POPJ P,

UNEX:	OUTSTR[ASCIZ/UNEXPECTED END
/]
	JRST DONE

APNT:	(A)
WRD:	0↔-1
ENDTST:	20

IBUF:	BLOCK	3
OBUF:	BLOCK	3
ENTR:	BLOCK	4
FILE:	BLOCK	4
PDL:	BLOCK LPDL
;FILE NAME SCANNER.  ERROR ROUTINES.

FSCAN:	RESCAN      		;RESCAN TO LOOK FOR A FILE NAME.
L1:	INCHWL	A		;FLUSH TO THE SEMICOLON
	CAIN	A,12		;OR TO LF
	JRST	DEFNAM		;USE DEFAULT NAME - NO SEMI SEEN
	CAIE	A,";"		;SEMI-COLON YET?
	JRST	L1		;NO, CONTINUE SCANNING

FILNAM:	SETZM	FILE
	MOVE	A,[FILE,,FILE+1]
	BLT	A,FILE+3
	PUSHJ	P,GETSIX	;GET THE FILE NAME
	JUMPE	B,DEFNAM	;IF NO NAME SEEN, USE THE DEFAULT
	MOVEM	B,FILE
	CAIE	A,"."
	JRST	FSP
	PUSHJ	P,GETSIX
	HLLZM	B,FILE+1
FSP:	CAIE	A,"["
	JRST	FSCR
	PUSHJ	P,GETSIX
	CAIE	A,","
	JRST	FERR
	PUSHJ	P,RADJ
	HLLZM	B,FILE+3
	PUSHJ	P,GETSIX
	PUSHJ	P,RADJ
	HLRM	B,FILE+3
	MOVEI	B,0
	CAIN	A,"]"
	PUSHJ	P,GETSIX
	JUMPN	B,FERR
FSCR:	CAIE	A,12
	JRST	FERR
	POPJ	P,

DEFNAM:	MOVE	A,['PPSAV ']	;RETURN DEFAULT NAME.
	MOVEM	A,FILE
	MOVSI	A,'TMP'  
	MOVEM	A,FILE+1
	SETZM	FILE+2
	SETZM	FILE+3
	POPJ	P,

GETSIX:	MOVEI	B,0
	MOVE	C,[POINT 6,B]
GETSX1:	INCHWL	A
	CAIE	A,40
	CAIN	A,15
	JRST	GETSX1
	CAIL	A,"A"+40
	CAILE	A,"Z"+40
	JRST	.+2
	JRST	GETSX3
	CAIL	A,"A"
	CAILE	A,"Z"
	JRST	.+2
	JRST	GETSX2
	CAIL	A,"0"
	CAILE	A,"9"
	POPJ	P,		;DELIMITER IS ANY NON-SIXBIT CHARACTER

GETSX2:	SUBI	A," "
GETSX3:	TLNE	C,770000
	IDPB	A,C
	JRST	GETSX1

RADJ:	JUMPE	B,FERR1
	TRNE	B,-1
	JRST	FERR1
	TLNE	B,77
	POPJ	P,
	LSH	B,-6
	JRST	.-3

FERR1:	POP	P,(P)
FERR:	CLRBFI
	OUTSTR	[ASCIZ/
Illegal file name. Try again: /]
	JRST	FILNAM

SYMERR:	OUTSTR[ASCIZ/CAN'T GET SYMS
/]
	EXIT

ENTFAI:	OUTSTR	[ASCIZ/ENTER FAILED
/]
	EXIT


LKEND←←BEG
.INSERT LOOK[FW,REG]